home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / info-service / gopher / incoming / goform.shar / goform next >
Encoding:
Text File  |  1993-04-09  |  11.8 KB  |  394 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # goform -- crude telnettable Gopher form fillout daemon
  4. #
  5. # History:
  6. # PASR 03/09/93    Original version (release 0.1) by Prentiss Riddle,
  7. #        riddle@rice.edu.
  8. # PASR 03/29/93    Use CRLF on output to user, to make Macs and PCs happy;
  9. #        explicitly send an IAC WONT ECHO so Mac telnet clients
  10. #        will know that they have to echo locally.
  11. # PASR 04/02/93 Added "Reply-To" handling.  Declared this version 0.2.
  12. #
  13. #-------------------------------------------------------------------------
  14. #
  15. # INSTALLATION:
  16. # 
  17. # The goform program should be executed from inetd with the name of the
  18. # form file as an argument.  In order to have multiple goform forms
  19. # available, each should be assigned a separate port.  An example SunOS
  20. # 4.1.2 installation:
  21. # 
  22. # Files installed:
  23. #     /foo/cwis/bin/goform        executable
  24. #     /foo/cwis/etc/widget.form    Widget Request form
  25. #     /foo/cwis/etc/suggest.form    Suggestion Box form
  26. # 
  27. # Added to /etc/services (be sure to make yp afterward):
  28. #    goform10003      10003/tcp           # gopher form: widget request
  29. #    goform10004      10004/tcp           # gopher form: suggestion box
  30. # 
  31. # Added to /etc/inetd.conf (be sure to HUP inetd afterward):
  32. #    goform10003      stream  tcp     nowait  nobody    /foo/cwis/bin/goform        goform /foo/cwis/etc/widget.form
  33. #    goform10004      stream  tcp     nowait  nobody    /foo/cwis/bin/goform        goform /foo/cwis/etc/suggest.form
  34. # 
  35. # 
  36. # FORMFILE FORMAT:
  37. #
  38. # The first few lines of the formfile specify header lines which will be
  39. # used to mail off the results after the form is filled out, as follows:
  40. #
  41. #    To: recipient-address
  42. #    Subject: subject-line
  43. #    Reply-To: return-address
  44. #
  45. # The recipient address must be fixed but the subject line and the return
  46. # address may contain field specifications in the form of a '$' character
  47. # followed by an integer.  These will be expanded to include the
  48. # user's answers to the correspondingly numbered questions.  The Reply-To
  49. # line is optional; if it is omitted, a "Reply-To:" line will appear in 
  50. # the mail header with no argument.  Note that the program doesn't do any
  51. # error checking of the address specified in the Reply-To field, so
  52. # recipients should use care in replying.
  53. #
  54. # The remainder of the formfile specifies the form to be filled out.
  55. #
  56. # Lines containing a '[' are interpreted as questions.  Characters following
  57. # the '[' are taken to be a default value for the answer.  Characters
  58. # preceding the '[' are taken to be a prompt.  If there is no prompt
  59. # preceding the '[', the question is taken to be a running essay questions
  60. # and multiple lines of input are accepted until a blank line or a line
  61. # consisting of a single '.' is read.
  62. #
  63. # Non-question lines in the formfile are displayed to the user and/or
  64. # displayed together with the user's answers in the results sent by mail:
  65. # -- Lines beginning in '>' are displayed to the user but not mailed.
  66. # -- Lines beginning in '<' are mailed but not displayed to the user.
  67. # -- Lines beginning in '#' are comments and are ignored.
  68. # -- Lines containing no '[' and not beginning in '>', '<' or '#' are both
  69. #    displayed to the user and mailed.
  70. #
  71. #
  72. # EXAMPLE FORMFILE:
  73. #
  74. # To: widgetmeister@foobar.edu
  75. # Subject: Widget request from $2 ($1)
  76. # Reply-To: $1
  77. # # Test form.  This is a comment.
  78. #                           WIDGET REQUEST FORM
  79. # >
  80. # >Widget Services supplies widgets only to registered students, faculty
  81. # >and staff of Foobar University.
  82. # >
  83. # >To pick up your widget go to Room 101 between the hours of 1-2 pm
  84. # >Monday through Wednesday.
  85. # 
  86. # Personal info (e-mail address, name, office address, extension):
  87. #   E-mail address: [
  88. #             Name: [
  89. #   Office address: [
  90. #        Extension: [
  91. # 
  92. # Widget shape (round, square, triangular -- CHOOSE ONE):
  93. #        Round: [n
  94. #       Square: [n
  95. #   Triangular: [n
  96. # 
  97. # Number of widgets desired: [1
  98. # 
  99. # What additional features would you like to see in a widget?
  100. # [
  101. # 
  102. # <--------------------------------------------------------------------
  103. # <                          FOR OFFICE USE ONLY
  104. # <
  105. # < Processed by: ____________________________   Date: ________________
  106. # < 
  107. # < Comments: _________________________________________________________
  108. # <--------------------------------------------------------------------
  109. #    
  110. #-------------------------------------------------------------------------
  111. # Global variables:
  112. #  $ReplyTo   "Reply-To:" line
  113. #  $Subject   "Subject:" line
  114. #  $To        "To:" line
  115. #  $def       are there any default answers in @ans?
  116. #  $formfile  name of the file from which form will be taken
  117. #  $mailer    mail delivery program
  118. #  $nans      number of answers in @ansindex (and possible answers in @ans)
  119. #  $nl        number of lines in @lines
  120. #  @ans       answers from user (may be predetermined defaults)
  121. #  @ansindex  table to look up Nth answer in @ans (since @ans is sparse)
  122. #  @lines     lines in form
  123. #  @question  array of flags: does this line (in @lines) ask a question?
  124. #  FORM       file handle for form file
  125.  
  126. #-------------------------------------------------------------------------
  127.  
  128. require("ctime.pl");
  129.  
  130. $mailer = "/bin/mail";
  131. $usage = "usage: goform formfile";
  132.  
  133. # Parse command-line arguments.
  134. die("$usage\n") unless ($#ARGV == 0);
  135. $formfile = $ARGV[0];
  136.  
  137. # Immediately flush all output to STDOUT.  Send an "IAC WONT ECHO" string
  138. # (per RFCs 1184 and 857) so the Mac client will know it has to echo text
  139. # locally.  Then throw away an initial line of input in order to dispose of
  140. # any remaining telnet protocol cruft.
  141. $| = 1;
  142. print("\377\374\001\n");            # IAC WONT ECHO
  143. print("Press return to begin:\r\n");
  144. $whatnow = <STDIN>;
  145. print("\r\n\r\n\r\n\r\n");
  146.  
  147. &parseform();
  148.  
  149. do {
  150.     &makepass();
  151.  
  152.     do {
  153.         print("\r\nSave/Cancel/Revise (s/c/r)? ");
  154.         $whatnow = <STDIN>;
  155.         $whatnow =~ tr/A-Z/a-z/;
  156.     } until($whatnow =~ /^\s*(s|save|c|cancel|r|revise)\s*$/);
  157.     if ($whatnow =~ /^\s*(c|cancel)\s*$/) {
  158.         print("Cancelling...")
  159.         &sleep(1);
  160.         exit(0);
  161.     }
  162.     print("\r\n\r\n\r\n\r\n");
  163. } until ($whatnow =~ /^\s*(s|save)\s*$/);
  164.  
  165. $Subject = &fixfields($Subject);
  166. $ReplyTo = &fixfields($ReplyTo);
  167.  
  168. &sendform();
  169.  
  170. #-------------------------------------------------------------------------
  171. # clean -- remove leading and final whitespace from a string.
  172. #
  173. # usage: $str = &clean($str);
  174.  
  175. sub clean {
  176.     local($str) = @_;
  177.     $str =~ s/^\s*//;
  178.     $str =~ s/\s*$//;
  179.     return($str);
  180. }
  181. #-------------------------------------------------------------------------
  182. # fixfields -- fill out "$N" items in Subject and Reply-To lines with
  183. #              corresponding answers
  184. #
  185. # Global variables used:  $ans  $ansindex
  186.  
  187. sub fixfields {
  188.     local($oldsubj) = @_;
  189.     local($l, $newsubj, $s);
  190.  
  191.     # Step through the Subject line.  When you find a "$n", substitute
  192.     # the corresponding answer field.
  193.     $newsubj = $oldsubj;
  194.     while ($newsubj =~ s/\$(\d*)/$ans[$ansindex[$1 - 1]]/e) {
  195.         # do nothing
  196.     }
  197.     return($newsubj);
  198. }
  199. #-------------------------------------------------------------------------
  200. # Make a pass through the form.
  201. #
  202. # Global variables used:
  203.  
  204. sub makepass {
  205.     local($char, $l, $resp);
  206.  
  207. #    # Remind the user how defaults work (unless this is the first
  208. #    # pass and there are none).
  209. #    if ($def) {
  210. #        print("\r\nNOTE:\r\n");
  211. #        print("To accept pre-defined values (in []), press return.\r\n");
  212. #        print("To delete a pre-defined value, type a space.\r\n\r\n");
  213. #    }
  214. #    $def = 1;
  215.  
  216.     # Loop through the lines in the form.
  217.     for ($l = 0; $l < $nl; $l++) {
  218.  
  219.         # Is there a question associated with this line?
  220.         if ($question[$l]) {
  221.             # Do we have a default answer for this question?
  222.             if ($ans[$l]) {
  223.                 printf("$lines[$l]<$ans[$l]> ");
  224.             } else {
  225.                 print("$lines[$l]");
  226.             }
  227.             # Is this a run-on essay question? (Is there a prompt?)
  228.             if ($lines[$l]) {
  229.                 # No, get a single answer.
  230.                 $resp = <STDIN>;
  231.                 $resp =~ s/[\r\n]*$//;
  232.                 $ans[$l] = &clean($resp) if ($resp);
  233.             } else {
  234.                 # Yes, it's a run-on question  -- accept
  235.                 # multiple lines in a single answer.
  236.                 print("\r\n") if ($ans[$l]);
  237.                 print("(Enter a blank line to finish.)\r\n");
  238.                 $resp = <STDIN>;
  239.                 $resp =~ s/[\r\n]*$//;
  240.                 if ($resp) {
  241.                     $ans[$l] = "";
  242.                     do {
  243.                         $ans[$l] .= &clean($resp) . " ";
  244.                         $resp = <STDIN>;
  245.                         $resp =~ s/[\r\n]*$//;
  246.                     } while ($resp);
  247.                 }
  248.             }
  249.         } else {
  250.             # This isn't a question -- print it unless it's
  251.             # intended only for the final mail.
  252.             $char = substr($lines[$l], 0, 1);
  253.             next if ($char eq "<" | $char eq '#');
  254.             if ($char eq ">") {
  255.                 print(substr($lines[$l], 1), "\r\n");
  256.             } else {
  257.                 print("$lines[$l]\r\n");
  258.             }
  259.         }
  260.     }
  261. }
  262. #-------------------------------------------------------------------------
  263. # mmddyy -- return date in the form "mm/dd/yy"
  264. #
  265. # Portability issue: we count on &ctime() to return the date in one of
  266. # the two following formats:
  267. #
  268. #       Wed Feb 24 10:42:22 1993
  269. #       Wed Feb 24 10:42:22 CST 1993
  270. #
  271. # If it doesn't, we're in trouble...
  272.  
  273. sub mmddyy {
  274.     local($date, $dd, $mm, $yy);
  275.  
  276.     $date = &ctime(time);
  277.     ($yy) = $date =~ /\s\d\d(\d\d)\s*$/;
  278.     $mm = &monthindex(substr($date, 4, 3));
  279.         $dd = substr($date, 8, 2);
  280.         $dd =~ s/ /0/;
  281.     return("$mm/$dd/$yy");
  282. }
  283. #--------------------------------------------------------------------------
  284. # monthindex -- given a three-character month abbreviation, return the
  285. #               corresponding integer "01" (January) to "12" (December)
  286. #
  287. # usage: $mm = &monthindex($monthstr);
  288. # error: return -1 in case of error;
  289.  
  290. sub monthindex {
  291.         local($monthstr) = @_;
  292.         local($mm);
  293.         $monthstr =~ tr/A-Z/a-z/;
  294.         $mm = index("janfebmaraprmayjunjulaugsepoctnovdec", $monthstr) / 3 + 1;
  295.         $mm = -1 if ($mm <= 0 || $mm > 12);
  296.         $mm = "0" . $mm if ($mm > 0 && $mm < 10);
  297.         return $mm;
  298. }
  299. #-------------------------------------------------------------------------
  300. # Parse the form.
  301. #
  302. # Global variables used:      FORM
  303. # Global variables modified:  $ReplyTo  $Subject  $To  $ans  $ansindex
  304. #                             $def  $formfile  $nans  $nl  $lines  $question
  305.  
  306. sub parseform {
  307.     local($_);
  308.  
  309.     open(FORM, "< $formfile") || die("Can't open form $formfile");
  310.  
  311.     $nans = 0;
  312.     $nl = 0;
  313.     $def = 0;
  314.     while ($_ = <FORM>) {
  315.         chop($_);
  316.     
  317.         # Discard comments.
  318.         next if (/^#/);
  319.     
  320.         # Find first instances of header lines.
  321.         if (!$ReplyTo && /^Reply-To:\s+(\S.*)/) {
  322.             $ReplyTo = $1;
  323.             next;
  324.         }
  325.         if (!$Subject && /^Subject:\s+(\S.*)/) {
  326.             $Subject = $1;
  327.             next;
  328.         }
  329.         if (!$To && /^To:\s+(\S.*)/) {
  330.             $To = $1;
  331.             next;
  332.         }
  333.     
  334.         # Determine which lines contain input markers ("[") and of
  335.         # those, which contain predetermined defaults.
  336.         if (/^(.*)\[(.*)\]?$/) {
  337.             $question[$nl] = 1;
  338.             $lines[$nl] = $1;
  339.             $ans[$nl] = $2;
  340.             $ansindex[$nans] = $nl;
  341.             $nans++;
  342.         } else {
  343.             $lines[$nl] = $_;
  344.         }
  345.         $nl++;
  346.     }
  347. }
  348. #-------------------------------------------------------------------------
  349. # sendform -- mail the resulting form off to the recipients defined in the
  350. #             "To:" line.
  351. #
  352. # Global variables used:  $ReplyTo  $Subject  $To  $ans  $lines  $mailer  $nl
  353.  
  354. format MAIL = 
  355. ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  356. $line
  357. ~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  358.   $line
  359. .
  360. sub sendform {
  361.     local($char, $l, $line, $s);
  362.  
  363.     print("Sending...\r\n");
  364.  
  365.     # Open the mail process
  366.     $To =~ s/'//g;            # sanitized for your protection
  367.     open(MAIL, "| $mailer '$To'")
  368.         || die("unable to open mailer $mailer to $To");
  369.  
  370.     print(MAIL "Subject: $Subject\r\nReply-To: $ReplyTo\r\n\r\n");
  371.  
  372.     print(MAIL "Date: " . &mmddyy() . "\r\n");
  373.  
  374.     for($l=0; $l<$nl; $l++) {
  375.         # Skip lines intended only for the user.
  376.         $char = substr($lines[$l], 0, 1);
  377.         next if ($char eq ">" | $char eq '#');
  378.         if ($char eq "<") {
  379.             # This line intended only for mail recipient.
  380.             $line = substr($lines[$l], 1);
  381.         } elsif ($lines[$l]) {
  382.             # Normal line -- may include an answer.
  383.             $line = $lines[$l] . $ans[$l];
  384.         } else {
  385.             # Indent lines with no question.
  386.             $line = "  " . $ans[$l];
  387.         }
  388.         write(MAIL);
  389.     }
  390.     close(MAIL);
  391. }
  392. #-------------------------------------------------------------------------
  393. # end of goform script
  394.